perm filename XAP3[XAP,BGB] blob sn#052882 filedate 1973-07-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001	   VALID 00004 PAGES
C00002 00002	SUBR(GETFIL)	GET FILE SPECIFICATION.
C00004 00003	SUBR(GETCHR)	GET A CHARACTER FROM THE TEXT BUFFER.
C00006 00004	SUBR(INFILE)	INDIRECT FILE COMMAND "@".
C00009 ENDMK
C⊗;
SUBR(GETFIL)	;GET FILE SPECIFICATION.
BEGIN GETFIL;_____________________________________________________

;CLEAR FILENAME SPECIFICATION.
	DZM FILNAM
	DZM EXTION
	DZM EXTION+1
	DZM PPPN

;AC1-CHR, AC2-CNT, AC3, AC4-BP.
	LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
	CALL(GETCHR)
	CAIN 1,15↔GO[CALL(GETCHR)↔POP0J]
	SKIPA
L:	CALL(GETCHR)
	CAILE 1,"z"↔POP0J
	CAIL 1,"a"↔SUBI 1,40		;CONVERT LOWER CASE
	CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
	CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
	CAIN 1,","↔GO[LAC 4,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
	CAIN 1,"]"↔CALL(GETCHR)
	CAIN 1,";"↔GO EOL	;XAP COMMAND POSTFIX.
	CAIG 1," "↔GO EOL
	SOJL 2,L↔SUBI 1,40	;COUNT'EM AND CONVERT TO SIXBIT.
	IDPB 1,4↔GO L		;PACK CHARACTER INTO SPECIFICATIONS.
EOL:	
	CAR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DIP PPPN
	CDR PPPN↔TRNN 77↔LSH -6↔TRNN 77↔LSH -6↔DAP PPPN
	POP0J
BEND GETFIL;BB 30 MAY 1973.___________________________________________
SUBR(GETCHR)	GET A CHARACTER FROM THE TEXT BUFFER.
BEGIN GETCHR;_____________________________________________________
	SOSGE CHRCNT↔GO .+3
	ILDB 1,TXTPTR↔POP0J
	SETOM EOF↔SETZ 1,
	POP0J
BEND  GETCHR;BGB 30 MAY 1973._____________________________________

SUBR(GETNUM)	GET AN INTEGER.
BEGIN GETNUM;________________________________________________________
	SETZM↔CALL(GETCHR)
	CAIL 1,"0"↔CAILE 1,"9"↔GO[
	EXCH 1,0↔POP0J]↔ANDI 1,17
	IMULI 0,=10↔ADD 0,1
	GO GETNUM+1
BEND GETNUM;_________________________________________________________

SUBR(GET14)	GET A 14 BIT NUMBER
BEGIN GET14
	CALL(GETCHR)↔LSH 1,7↔PUSH P,1
	CALL(GETCHR)↔ADD 1,(P)↔POP P,(P)
	POP0J
BEND GET14;__________________________________________________________
SUBR(INFILE)	INDIRECT FILE COMMAND "@".
BEGIN INFILE;_____________________________________________________

;FILE INITIALIZATION.
	PUSH P,TXTPTR			;SAVE TEXT POINTER.
	INIT 1,17↔SIXBIT/DSK/↔0
	GO[FATAL(CAN'T INIT DSK)]
	CALL(GETFIL)
	LOOKUP 1,FILNAM↔GO L1

;WIPE OUT INDIRECT COMMAND.
	POP P,1↔ADD 1,[7B5]	;DECREMENT OLDE TEXT POINTER.
	LACI"F"↔IDPB 0,1
	LACI"."↔IDPB 0,1
	DAPZ 1,PTR1#
 	SETZ↔IDPB 0,1
	CAME 1,TXTPTR↔GO .-2
	DAPZ 1,PTR2#
	
;EXPAND CORE WHEN NECESSARY.
	NIP PPPN↔MOVMS↔DAC SIZE#		;WORD COUNT.
	IMULI =5↔ADDM CHRCNT			;NEW CHARACTER COUNT.
	LAC 1,TXTEND↔ADD 1,SIZE↔DAC 1,NEWEND#	;NEW TOP OF CORE.
	CDR 1,NEWEND↔CAMG 1,JOBREL↔GO .+3
	CORE 1,↔GO[FATAL(<NO ROOM FOR TEXT.>)]

;MOVE TOP OF TEXT BUFFER UP CORE.
	SETO 1,↔LAP 1,TXTEND
	LAC SIZE↔DAP .+3
	CDR TXTEND↔SUB PTR2
	POP 1,SIZE(1)↔SOJG .-1

;STEP ON A FUNNY CASE.
	LAC 1,PTR1↔LAC 2,PTR2↔CAME 1,2↔GO L2
	ADD 2,SIZE↔LIPI 1,440700↔LIPI 2,440700
	SETZ 3,↔LACI 4,5
	ILDB 0,1↔IDPB 3,2	;CLEAR LEADING BYTES OF TWO.
	SOJLE 4,L2↔JUMPN  0,.-3
	IDPB 3,2↔SOJG 4,.-1	;CLEAR LAGGING BYTES OF ONE.
L2:

;INPUT THE FILE.
	LAC NEWEND↔DAC TXTEND
;	LAC PPPN↔LAP PTR1↔DAC DUMARG
	LAC PTR1↔LIPI 000700↔DAC TXTPTR↔HLL PPPN↔DAC DUMARG
	IN 1,DUMARG↔GO[ RELEASE 1, 
		SETZM CMODE			;ENTER TEXT MODE.
		POP0J ]
	FATAL(READ ERROR!)
DUMARG:0↔0
L1: 	OUTSTR[ASCIZ/FILE NOT FOUND  -  /]
	POP P,1↔LAC 2,[POINT 7,4]↔LACI 3,=25
	ILDB 1↔CAIN";"↔GO .+3↔IDPB 2↔SOJG 3,.-4
	SETZ↔IDPB 2↔OUTSTR 4↔CRLF↔EXIT
BEND INFILE;BGB 30 MAY 1973.--------------------------------------